home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / PUTTEXT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  1.9 KB  |  73 lines
  1. { puttext.pas -- Put text into clipboard }
  2.  
  3. program PutText;
  4.  
  5. uses WinTypes, WinProcs, WinCrt, Strings;
  6.  
  7. const
  8.  
  9.   winCrtClassName = 'TPWinCrt';
  10.  
  11. var
  12.  
  13.   HWindow: HWnd;              { Handle to WinCrt window }
  14.   S: array[0 .. 80] of Char;  { String to copy to clipboard }
  15.  
  16. {- Return true if text at P is copied to clipboard }
  17. function PutClipText(HWindow: HWnd; P: PChar): Boolean;
  18. var
  19.   GHandle: THandle;
  20.   GPtr: PChar;
  21. begin
  22.   PutClipText := false;
  23.   if (P <> nil) and (StrLen(P) > 0) then
  24.   begin
  25.     GHandle := GlobalAlloc(gmem_Moveable, StrLen(P) + 1);
  26.     if GHandle <> 0 then
  27.     begin
  28.       GPtr := GlobalLock(GHandle);
  29.       if GPtr = nil then
  30.         GlobalFree(GHandle)
  31.       else begin
  32.         StrCopy(GPtr, P);
  33.         GlobalUnlock(GHandle);
  34.         if not OpenClipboard(HWindow) then
  35.           GlobalFree(GHandle)
  36.         else begin
  37.           EmptyClipboard;
  38.           SetClipboardData(cf_Text, GHandle);
  39.           CloseClipboard;
  40.           PutClipText := true
  41.         end
  42.       end
  43.     end
  44.   end
  45. end;
  46.  
  47. begin
  48.   InitWinCrt;  { Registers window class for FindWindow }
  49.   HWindow := FindWindow(winCrtClassName, nil);
  50.   if HWindow = 0 then
  51.     Writeln('*** Unable to find WinCrt''s window handle')
  52.   else begin
  53.     Writeln('Send text to clipboard');
  54.     Writeln('----------------------');
  55.     repeat
  56.       Writeln('Enter text or press Enter to end');
  57.       Write('>');
  58.       Readln(S);
  59.       if PutClipText(HWindow, S) then
  60.         Writeln('Text copied to clipboard')
  61.       else
  62.         Writeln('No text to copy or error')
  63.     until StrLen(S) = 0
  64.   end;
  65.   Write('Type Alt+F4 to close window')
  66. end.
  67.  
  68.  
  69. {--------------------------------------------------------------
  70.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  71.   Revision 1.00    Date: 5/25/1991
  72. ---------------------------------------------------------------}
  73.